home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GEVENT.IMP < prev    next >
Encoding:
Text File  |  1992-09-01  |  16.2 KB  |  502 lines
  1.    {*******************************************************************
  2.  
  3.    GEVENT.IMP
  4.  
  5.    *******************************************************************}
  6.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  7.  
  8.    ZOOM
  9.  
  10.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  11.    {===================================================================
  12.  
  13.    UNZOOM - shrink
  14.  
  15.    ===================================================================}
  16. procedure hdUnZoom ;
  17.    {-------------------------------------------------------------------
  18.    Shrink if full size
  19.    -------------------------------------------------------------------}
  20. procedure Action ( P : PView ) ; FAR ;
  21. begin
  22.    if IsZoomed ( P ) then
  23.       Message ( P , evCommand , cmZoom , NIL ) ;
  24. end ;
  25.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  26.    PROCESS
  27.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  28. begin
  29.    Desktop^.ForEach ( @Action ) ;
  30. end ;
  31.    {===================================================================
  32.  
  33.    ZOOM - expand
  34.  
  35.    ===================================================================}
  36. procedure hdZoom ;
  37.    {-------------------------------------------------------------------
  38.    Expand if not full size
  39.    -------------------------------------------------------------------}
  40. procedure Action ( P : PView ) ; FAR ;
  41. begin
  42.    if not IsZoomed ( P ) then
  43.       Message ( P , evCommand , cmZoom , NIL ) ;
  44. end ;
  45.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  46.    PROCESS
  47.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  48. begin
  49.    Desktop^.ForEach ( @Action ) ;
  50. end ;
  51.    {===================================================================
  52.  
  53.    ALL ZOOMED - return FALSE if any window not zoomed
  54.  
  55.    ===================================================================}
  56. function AllZoomed : boolean ;
  57. var
  58.    w                         : word ;
  59.    {-------------------------------------------------------------------
  60.    Is it full size?
  61.    -------------------------------------------------------------------}
  62. procedure Action ( P : PView ) ; FAR ;
  63. begin
  64.    if not Zoomable ( P ) then EXIT ;
  65.    if not IsZoomed ( P ) then inc ( w ) ;
  66. end ;
  67.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  68.    PROCESS
  69.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  70. begin
  71.    w                         := 0 ;
  72.    Desktop^.ForEach ( @Action ) ;
  73.    AllZoomed                 := w = 0 ;
  74. end ;
  75.    {===================================================================
  76.  
  77.    ZOOM ALL
  78.  
  79.    ===================================================================}
  80. procedure hdZoomAll ;
  81. begin
  82.    if AllZoomed then
  83.       hdUnZoom
  84.    else
  85.       hdZoom ;
  86. end ;
  87.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  88.  
  89.    MISC
  90.  
  91.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  92.    {===================================================================
  93.  
  94.    TILE - VERTICAL (standard)
  95.  
  96.    ===================================================================}
  97. procedure hdTile ;
  98. var
  99.    R                         : TRect ;
  100. begin
  101.    Desktop^.GetExtent ( R ) ;
  102.    Desktop^.Tile ( R ) ;
  103. end ;
  104.    {===================================================================
  105.  
  106.    CASCADE
  107.  
  108.    ===================================================================}
  109. procedure hdCascade ;
  110. var
  111.    R                         : TRect ;
  112. begin
  113.    Desktop^.GetExtent ( R ) ;
  114.    Desktop^.Cascade ( R ) ;
  115. end ;
  116.    {===================================================================
  117.  
  118.    DIRECTORY
  119.  
  120.    ===================================================================}
  121. procedure hdChangeDir ;
  122. begin
  123.    ExecDialog ( New ( PChDirDialog ,
  124.                       Init ( cdNormal , 0 ) ) , NIL ) ;
  125.    hdRefreshDisplay ;
  126. end ;
  127.    {===================================================================
  128.  
  129.    SHOW
  130.  
  131.    ===================================================================}
  132. procedure hdShowClipboard ;
  133. begin
  134.    ClipWindow^.Select ;
  135.    ClipWindow^.Show ;
  136. end ;
  137.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  138.  
  139.    DISPLAY
  140.  
  141.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  142.    {===================================================================
  143.  
  144.    COPY SCREEN - copy from saved buffer to the Clipboard
  145.  
  146.    ===================================================================}
  147. procedure hdCopyScreen ;
  148. var
  149.    y                         : byte ;
  150.    Ch                        : char ;
  151.    S                         : string ;
  152. begin
  153.    ClipWindow^.Hide ;
  154.    VisionOFF ;
  155.    PullScreen ;                                   { From saved buffer }
  156.    with ClipWindow^.Editor^ do
  157.    begin
  158.       SetSelect ( 0 , BufLen , TRUE ) ;                    { all text }
  159.       DeleteSelect ;                                        { dump it }
  160.       for y := 1 to BiosHeight do                               { ROW }
  161.       begin
  162.          S                   := GetLine ( y , SaveScreen ) ;
  163.          S                   := TrimRight ( S , #32 ) ;
  164.          InsertText ( @S[1] , length ( S ) , FALSE ) ;
  165.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  166.    AVOID CR/LF ON LAST LINE
  167.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  168.          if y < BiosHeight then
  169.          begin
  170.             Ch               := #13 ;
  171.             InsertText ( @Ch , 1 , FALSE ) ;                 { add CR }
  172.             Ch               := #10 ;                        { add LF }
  173.             InsertText ( @Ch , 1 , FALSE ) ;
  174.          end ;
  175.       end ;
  176.    end ;
  177.    VisionON ;
  178.    ClipWindow^.Select ;
  179.    ClipWindow^.Show ;
  180.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  181.    Goto top line
  182.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  183.    Message ( ClipWindow , evKeyDown , kbCtrlPgUp , NIL ) ;
  184. end ;
  185.    {===================================================================
  186.  
  187.    REDRAW
  188.  
  189.    ===================================================================}
  190. procedure hdRefreshDisplay ;
  191. begin
  192.    DoneMemory ;                                  { Dump cache buffers }
  193.    Application^.Redraw ;                              { Redisplay all }
  194. end ;
  195.    {===================================================================
  196.  
  197.    USER SCREEN
  198.  
  199.    ===================================================================}
  200. procedure hdUserScreen ;
  201.    {-------------------------------------------------------------------
  202.    -------------------------------------------------------------------}
  203. procedure Hide ( P : PView ) ; FAR ;
  204. begin
  205.    P^.Hide ;
  206. end ;
  207.    {-------------------------------------------------------------------
  208.    -------------------------------------------------------------------}
  209. procedure Show ( P : PView ) ; FAR ;
  210. begin
  211.    P^.Show ;
  212. end ;
  213.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  214.    PROCESS
  215.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  216. var
  217.    Event                     : TEvent ;
  218. begin
  219.    if SaveScreen = NIL then EXIT ;
  220.    HideMouse ;
  221.    Application^.ForEach ( @Hide ) ;
  222.    Application^.Hide ;
  223.    Message ( Application ,
  224.              evBroadcast ,
  225.              cmCommandSetChanged ,
  226.              NIL ) ;
  227.    VisionOFF ;
  228.    InitEvents ;
  229.    PullScreen ;                                   { From saved buffer }
  230.    Application^.ClearEvent ( Event ) ;
  231.    while Event.What = evNothing do
  232.    begin
  233.       Application^.GetEvent ( Event ) ;
  234.       case Event.What of
  235.       evCommand : ;
  236.       evBroadCast : ;
  237.       evKeyDown : ;
  238.       evMouseDown : ;
  239.       else
  240.          Application^.ClearEvent ( Event ) ;
  241.       end ;
  242.    end ;
  243.    DoneEvents ;
  244.    VisionON ;
  245.    Application^.ClearEvent ( Event ) ;
  246.    Application^.ForEach ( @Show ) ;
  247.    Application^.Show ;
  248.    ShowMouse ;
  249.    hdRefreshDisplay ;                                 { redraw screen }
  250.    Message ( Application ,
  251.              evBroadcast ,
  252.              cmCommandSetChanged ,
  253.              NIL ) ;
  254. end ;
  255.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  256.  
  257.    PALETTE & COLOR
  258.  
  259.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  260.    {===================================================================
  261.  
  262.    COLOR
  263.    
  264.    ===================================================================}
  265. procedure hdColor ;
  266. begin
  267.    AppPalette                := apColor ;
  268.    hdRefreshDisplay ;
  269. end ;
  270.    {===================================================================
  271.  
  272.    BW
  273.  
  274.    ===================================================================}
  275. procedure hdBlackWhite ;
  276. begin
  277.    AppPalette                := apBlackWhite ;
  278.    hdRefreshDisplay ;
  279. end ;
  280.    {===================================================================
  281.  
  282.    MONO
  283.  
  284.    ===================================================================}
  285. procedure hdMonochrome ;
  286. begin
  287.    AppPalette                := apMonochrome ;
  288.    hdRefreshDisplay ;
  289. end ;
  290.    {===================================================================
  291.  
  292.    RESET
  293.  
  294.    ===================================================================}
  295. procedure hdResetColors ;
  296. var
  297.    SaveAppPalette            : integer ;
  298.    S                         : string ;
  299. begin
  300.    SaveAppPalette            := AppPalette ;
  301.    AppPalette                := apColor ;
  302.    S                         := CColor ;
  303.    Move ( S [1] , Application^.GetPalette^[1] , length ( CColor ) ) ;
  304.  
  305.    AppPalette                := apBlackWhite ;
  306.    S                         := CBlackWhite ;
  307.    Move ( S [1] , Application^.GetPalette^[1] , length ( CBlackWhite ) ) ;
  308.  
  309.    AppPalette                := apMonochrome ;
  310.    S                         := CMonochrome ;
  311.    Move ( S [1] , Application^.GetPalette^[1] , length ( CMonochrome ) ) ;
  312.  
  313.    AppPalette                := SaveAppPalette ;
  314.    hdRefreshDisplay ;
  315. end ;
  316.    {===================================================================
  317.  
  318.    EGA/VGA
  319.  
  320.    ===================================================================}
  321. procedure hdVideoMode ;
  322. var
  323.    NewMode                   : Word ;
  324. begin
  325.    NewMode                   := ScreenMode xor smFont8x8;
  326.    if NewMode and smFont8x8 <> 0 then
  327.       ShadowSize.X           := 1                           { EGA/VGA }
  328.    else
  329.       ShadowSize.X           := 2 ;                         { 25-line }
  330.    Application^.SetScreenMode ( NewMode ) ;
  331. end ;
  332.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  333.  
  334.    DESKTOP
  335.  
  336.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  337.    {===================================================================
  338.  
  339.    CLEAR - prompt first
  340.  
  341.    ===================================================================}
  342. function hdClearDesktop : boolean ;
  343. begin
  344.    hdClearDesktop            := FALSE ;
  345.    if not Desktop^.Valid ( cmClose ) then EXIT ;    { prompt for save }
  346.    CloseAll ;                                               { dump'em }
  347.    ClearHistory ;                                         { free heap }
  348.    hdClearDesktop            := TRUE ;
  349. end ;
  350.    {===================================================================
  351.  
  352.    SAVE DESKTOP
  353.  
  354.    ===================================================================}
  355. procedure hdSaveDesktop ;
  356. begin
  357.    if not Desktop^.Valid ( cmClose ) then EXIT ;    { prompt for save }
  358.    SaveDesktopTo ( DesktopName , 'Desktop File' ) ;
  359. end ;
  360.    {===================================================================
  361.  
  362.    LOAD DESKTOP
  363.  
  364.    ===================================================================}
  365. procedure hdLoadDesktop ;
  366. begin
  367.    if not Desktop^.Valid ( cmClose ) then EXIT ;    { prompt for save }
  368.    LoadDesktopFrom ( DesktopName ) ;
  369. end ;
  370.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  371.  
  372.    EXEC
  373.  
  374.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  375.    {===================================================================
  376.  
  377.    EXEC - normal or Turbo Vision
  378.  
  379.    ===================================================================}
  380. function VisionExec ( Path , CmdLine : string ) : word ;
  381. var
  382.    DosScreen                 : boolean ;
  383.    {-------------------------------------------------------------------
  384.    MSG
  385.    -------------------------------------------------------------------}
  386. procedure ShellMsg ;
  387. begin
  388.    PrintStr ( #13#10 ) ;
  389.    PrintStr ( '                                    ▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌'#13#10 ) ;
  390.    PrintStr ( '                                    ▐ Type EXIT to return to the program... ▌'#13#10 ) ;
  391.    PrintStr ( '                                    ▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌'#13#10 ) ;
  392. end ;
  393.    {-------------------------------------------------------------------
  394.    OFF
  395.    -------------------------------------------------------------------}
  396. function AppOFF : boolean ;
  397. begin
  398.    AppOFF                    := FALSE ;
  399.    if DesktopName = '' then
  400.       VisionOFF
  401.    else
  402.    begin
  403.       if not Desktop^.Valid ( cmClose ) then EXIT ;
  404.       SaveDesktopTo ( DesktopName , 'Temporary EXEC - Desktop file' ) ;
  405.       CloseAll ;
  406.       DisposeClipboard ;
  407.       ClearHistory ;
  408.       DoneHistory ;
  409.       VisionOFF ;
  410.       if BufHeapSize > 0 then
  411.          DoneBuffers ;                              { restore heap }
  412.    end ;
  413.    if DosScreen then
  414.       PopScreen ;
  415.    AppOFF                    := TRUE ;
  416. end ;
  417.    {-------------------------------------------------------------------
  418.    ON
  419.    -------------------------------------------------------------------}
  420. procedure AppON ;
  421. begin
  422.    if DosScreen then
  423.       PushScreen ;
  424.    if DesktopName = '' then
  425.       VisionON 
  426.    else
  427.    begin
  428.       if BufHeapSize > 0 then
  429.          InitBuffers ;
  430.       VisionON ;
  431.       InitHistory ;
  432.       LoadDesktopFrom ( DesktopName ) ;
  433.       CreateClipboard ;
  434.    end ;
  435. end ;
  436.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  437.    PROCESS
  438.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  439. begin
  440.    VisionExec                := $FFFF ;
  441.    DosScreen                 := SaveScreen <> NIL ;
  442.    if Application <> NIL then
  443.       if not AppOFF then EXIT ;
  444.    if ( Path = GetEnv ( 'COMSPEC' ) ) and ( CmdLine = '' ) then
  445.       ShellMsg ;
  446.    VisionExec                := EXECPROC.Exec ( Path , CmdLine ) ;
  447.    if Application <> NIL then
  448.       AppON ;
  449. end ;
  450.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  451.  
  452.    SHELL - "VisionExec" saves desktop & takes care of "house cleaning"
  453.  
  454.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  455.    {===================================================================
  456.  
  457.    LITTLE - Available memory only.  "DesktopName" blanked so
  458.    Desktop is not saved/loaded (avoid disk/diskette access).
  459.  
  460.    ===================================================================}
  461. procedure hdLittleDOS ;
  462. var
  463.    Temp                      : PathStr ;
  464. begin
  465.    EXECPROC.UseExecSwap      := FALSE ;
  466.    Temp                      := DesktopName ;
  467.    DesktopName               := '' ;
  468.    VisionExec ( GetEnv ( 'COMSPEC' ) , '' ) ;
  469.    DesktopName               := Temp ;
  470. end ;
  471.    {===================================================================
  472.  
  473.    MEDIUM - Desktop is saved, then cleared.  Reloaded on return.
  474.  
  475.    ===================================================================}
  476. procedure hdMediumDOS ;
  477. begin
  478.    EXECPROC.UseExecSwap      := FALSE ;
  479.    VisionExec ( GetEnv ( 'COMSPEC' ) , '' ) ;
  480. end ;
  481.    {===================================================================
  482.  
  483.    BIG - Does Swap-to-Disk/EMS.  Desktop is saved & cleared, so
  484.    swap file is as small as possible.
  485.  
  486.    ===================================================================}
  487. procedure hdBigDOS ;
  488. begin
  489.    EXECPROC.UseExecSwap      := TRUE ;
  490.    VisionExec ( GetEnv ( 'COMSPEC' ) , '' ) ;
  491. end ;
  492.    {===================================================================
  493.  
  494.    DOS SHELL - for simpler applications.  If EXECSWAP is not used,
  495.    then "BigDOS" is the same as "MediumDOS".
  496.  
  497.    ===================================================================}
  498. procedure hdDosShell ;
  499. begin
  500.    hdBigDOS ;
  501. end ;
  502.